home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / 256obj.amos / 256obj.amosSourceCode
AMOS Source Code  |  1997-01-31  |  4KB  |  153 lines
  1. Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
  2. Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
  3.  
  4. Reserve As Work 14,640*640+12
  5. 'Reserve As Work 13,4096 
  6. Reserve As Work 12,40960
  7. Dim CO(63),R(255),G(255),B(255),PR(31),PG(31),PB(31)
  8. Global WOF,HOF,CO(),R(),G(),B(),PR(),PG(),PB()
  9. Trap Bload "ab3:includes/256pal",Start(14)
  10. If Errtrap
  11.    Screen To Front 7 : Screen 7
  12.    Locate 1,1 : Print Space$(78)
  13.    Locate 1,1 : Centre "Unable to load 'ab3:includes/256pal'"
  14.    Wait Key 
  15.    Edit 
  16. End If 
  17. S=Start(14)
  18. For A=0 To 255
  19.    R(A)=Deek(S) : Add S,2
  20.    G(A)=Deek(S) : Add S,2
  21.    B(A)=Deek(S) : Add S,2
  22. Next 
  23.  
  24. Repeat 
  25.    F$=Fsel$("ab3:graphics/","","Load Object Graphics")
  26.    If F$="" Then Edit 
  27.    Screen Open 0,640,640,32,Lowres
  28.    Curs Off : Flash Off : Cls 0
  29.    Wait Vbl 
  30.    ' Load Iff F$,0
  31.    Trap Load Iff F$
  32.    If Errtrap
  33.       Screen To Front 7 : Screen 7
  34.       Locate 1,1 : Print Space$(78)
  35.       Locate 1,1 : Centre "Unable to load '"+F$+"'"
  36.       Wait Key 
  37.       Edit 
  38.    End If 
  39.    
  40.    Trap Bload F$,Start(14)
  41.    If Errtrap
  42.       Screen To Front 7 : Screen 7
  43.       Locate 1,1 : Print Space$(78)
  44.       Locate 1,1 : Centre "Unable to load '"+F$+"'"
  45.       Wait Key 
  46.       Edit 
  47.    End If 
  48.    S=Hunt(Start(14) To Start(14)+10000,"CMAP")+8
  49.    For A=0 To 31
  50.       PR(A)=Peek(S) : Add S,1
  51.       PG(A)=Peek(S) : Add S,1
  52.       PB(A)=Peek(S) : Add S,1
  53.    Next 
  54.    
  55.    For A=0 To 31 : CO(A)=Colour(A)
  56.    Next 
  57.    Screen 7 : Screen To Front 7
  58.    Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Screen Width: ";WOS
  59.    Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Number of frames: ";NOF
  60.    Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Width of each frame: ";WOF
  61.    Locate 1,1 : Print Space$(78); : Locate 1,1 : Input "Height of each frame: ";HOF
  62.    Curs Off 
  63.    X=0 : Y=0
  64.    For A=0 To NOF-1
  65.       CONVERT[Start(14)+6+A*WOF*HOF,X,Y]
  66.       X=X+WOF : If X+WOF>WOS Then X=0 : Add Y,HOF
  67.    Next 
  68.    F$=Fsel$("ab3:includes/","","Save raw data file")
  69.    If F$="" Then End 
  70.    PSAVE[F$,NOF]
  71.  
  72.    Screen 7 : Locate 1,1 : Print Space$(78)
  73.    Locate 1,1 : Centre "All done, select another file, or cancel to quit"
  74.  
  75. Until 0
  76. Edit 
  77.  
  78. Procedure PSAVE[M$,NO]
  79.    L=(NO*WOF*HOF)-1
  80.    '
  81.    T=0
  82.    P=Start(12)
  83.    '
  84.    
  85.    S=Start(14)
  86.    Doke S,NO
  87.    Doke S+2,WOF
  88.    Doke S+4,HOF
  89.    Add S,6
  90.    Add S,L
  91.    Trap Bsave M$+".dat",Start(14) To S
  92.    If Errtrap
  93.       Screen To Front 7 : Screen 7
  94.       Locate 1,1 : Print Space$(78)
  95.       Locate 1,1 : Centre "Unable to save '"+M$+".dat'"
  96.       Wait Key 
  97.       Edit 
  98.    End If 
  99.    N=Start(12)
  100.    
  101.    Screen To Front 7 : Screen 7
  102.    Locate 1,1 : Print Space$(78)
  103.    Locate 10,1 : Print "Creating palette, please wait  "
  104.    
  105.    For A=0 To 31
  106.       V=32-A
  107.       For Q=0 To 31
  108.          Locate 42,1 : Print Using "(###.##% complete)";(A*32+Q)/10.24
  109.          R=PR(Q) : G=PG(Q) : B=PB(Q)
  110.          R=(R*V)/32 : G=(G*V)/32 : B=(B*V)/32
  111.          
  112.          DQ=10000000
  113.          TC=0
  114.          For Z=0 To 255
  115.             DR=Abs(R-R(Z))
  116.             DG=Abs(G-G(Z))
  117.             DB=Abs(B-B(Z))
  118.             
  119.             ND=(DR*3)+(DG*3)+(DB*3)
  120.             If ND<DQ Then DQ=ND : TC=Z
  121.          Next 
  122.          
  123.          Doke N,TC*256
  124.          Add N,2
  125.       Next 
  126.    Next 
  127.    
  128.    Trap Bsave M$+".256pal",Start(12) To N
  129.    If Errtrap
  130.       Screen To Front 7 : Screen 7
  131.       Locate 1,1 : Print Space$(78)
  132.       Locate 1,1 : Centre "Unable to save '"+M$+".256pal'"
  133.       Wait Key 
  134.       Edit 
  135.    End If 
  136. End Proc
  137. '
  138. Procedure CONVERT[ST,OX,OY]
  139.    
  140.    Screen To Front 7 : Screen 7
  141.    Locate 1,1 : Print Space$(78)
  142.    Locate 1,1 : Centre "Converting data..."
  143.    
  144.    Screen 0
  145.    Pen 0
  146.    For X=OX To OX+WOF-1
  147.       For Y=OY To OY+HOF-1
  148.          C= Extension_12_044C(X,Y)
  149.          Poke ST,C
  150.          Add ST,1
  151.           Extension_12_036E X,Y,0
  152.    Next : Next 
  153. End Proc